home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / CL5 / INV01.PRG < prev    next >
Encoding:
Text File  |  1993-11-26  |  3.3 KB  |  124 lines
  1. ///////////////////////////////////////////////////////////////
  2. //
  3. //  Module : INV01.PRG
  4. //
  5. //  Created by SUMMER'93 (c) on Fri Nov 26 14:50:17 1993
  6. //
  7. ///////////////////////////////////////////////////////////////
  8. #include "snj.ch"
  9. // The following statics were declared 'PUBLIC' in the S87 code
  10. // OR were private and inherited by called functions
  11. // If they are used outside this module there will be a set/get
  12. // function with the same name as the var in this module
  13. static PARTPLEN
  14. //       Printing an invoice
  15. procedure INVOUT( PINVNO ) // Amended by SUMMER93
  16. // Calls: QBPROMPT QBMESS CEILING QBPRCTL QBTXTMAC QBYESNO 
  17. // Called By: INVMAIN INVEDIT 
  18. // The following locals have been declared by Summer'93
  19. // NLOOPS I 
  20. local PC, PT, DOIT, NLOOPS, I
  21.  
  22. PC := chr( 18 ) + chr( 15 )
  23. PT := chr( 27 ) + ":" 
  24. DOIT := .t. 
  25.  
  26. if QBPROMPT( "Printer Loaded and Online|Quit|" )<> 1 
  27.     return 
  28. endif 
  29. if PINVNO  = 0 
  30.     do QBMESS with "Serious program error - how the hell did we get here?", ;
  31.     COLFLASH() , 15 
  32. endif 
  33.  
  34. do while DOIT 
  35.     select PARTLINE 
  36.     go top 
  37.     NLOOPS := max( int(CEILING(reccount() / 33 )), 1 )
  38.  
  39.     select INVOICE 
  40.     do QBPRCTL with "P" 
  41.     if GETOUT() 
  42.         return 
  43.     endif 
  44.     for I := 1 to NLOOPS 
  45.         do QBTXTMAC with "IVFORMAT.TXT" 
  46.         if NLOOPS > I 
  47.             if QBYESNO( "More to do - Ready with next Sheet?" ) = "N" 
  48.                 exit 
  49.             endif 
  50.         endif 
  51.     next 
  52.     do QBPRCTL with "R:Invoice printed" 
  53.     DOIT := ( QBYESNO("Print this Invoice again?" ) = "Y" )
  54. enddo 
  55. return 
  56.  
  57. //*****************************************************************
  58.  
  59. procedure QBTXTMAC( FNAME ) // Amended by SUMMER93
  60. // Calls: QBMESS ATNEXT 
  61. // Called By: INVOUT 
  62. //       uses clipper file reading facilities and
  63. //       Tom Rettig function atnext()
  64.  
  65. local BUFFER, OCC, OPOS, NPOS, MACLINE
  66.  
  67. PARTPLEN := 61 
  68. set alternate to INVTRACE.TXT 
  69. set alternate on 
  70. if file( FNAME )
  71.     BUFFER := memoread( FNAME )
  72. else 
  73.     do QBMESS with "Format file for Invoice missing", COLFLASH() , 10 
  74.     return 
  75. endif 
  76.  
  77. OCC := OPOS := NPOS := 1 
  78. do while .t. 
  79.     NPOS := ATNEXT( chr(13 ), BUFFER, OCC )
  80.     if NPOS  = 0 
  81.         exit 
  82.     endif 
  83.     MACLINE := substr( BUFFER, OPOS, NPOS - OPOS )
  84.     do case 
  85.         case substr( MACLINE, 1, 1 ) = "*" 
  86.             set print off 
  87.             do QBMESS with substr(MACLINE, 2 ), COLHEAD() , 0 
  88.             set print on 
  89.         case substr( MACLINE, 1, 1 ) = "?" 
  90.             MACLINE := substr( MACLINE, 2 )
  91.             ?? &MACLINE 
  92.         otherwise 
  93.             ?&MACLINE 
  94.     endcase 
  95.     OPOS := NPOS + 2 
  96.     OCC := OCC + 1 
  97. enddo 
  98.  
  99. set alternate off 
  100. set alternate to 
  101. return 
  102.  
  103. //*****************************************************************
  104.  
  105. function PRPART
  106. // Calls: 
  107. // Called By: 
  108. //  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 99  9999.99   9999.99
  109. local PSTR
  110.  
  111. PSTR := ""  // chr(18)+chr(15)                      && Set compressed
  112. select PARTLINE 
  113. if eof( )
  114.     PSTR := space( PARTPLEN )
  115. else 
  116.     PSTR := PSTR + FIELD->PARTDESC  + str( FIELD->QTY , 2 ) + space( 1 ) + str;
  117.     ( FIELD->UPRICE , 7, 2 ) + space( 4 ) + str( FIELD->TPRICE , 7, 2 )
  118.     PARTPLEN := len( PSTR )
  119.     skip 
  120. endif 
  121. select INVOICE 
  122. return PSTR  // +chr(27)+":"            && and set 12CPI
  123. // End of file
  124.